home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / djip / djip.ctl next >
Encoding:
Text File  |  1999-09-06  |  12.9 KB  |  412 lines
  1. VERSION 5.00
  2. Begin VB.UserControl DJIp 
  3.    Appearance      =   0  'Flat
  4.    BackColor       =   &H80000005&
  5.    BorderStyle     =   1  'Fixed Single
  6.    ClientHeight    =   465
  7.    ClientLeft      =   0
  8.    ClientTop       =   0
  9.    ClientWidth     =   2070
  10.    LockControls    =   -1  'True
  11.    ScaleHeight     =   465
  12.    ScaleWidth      =   2070
  13.    ToolboxBitmap   =   "DJIp.ctx":0000
  14.    Begin VB.Frame Frame1 
  15.       Appearance      =   0  'Flat
  16.       BackColor       =   &H80000005&
  17.       BorderStyle     =   0  'None
  18.       Caption         =   "Frame1"
  19.       ForeColor       =   &H80000008&
  20.       Height          =   240
  21.       Left            =   50
  22.       TabIndex        =   0
  23.       Top             =   50
  24.       Width           =   1845
  25.       Begin VB.TextBox txtOctet 
  26.          Alignment       =   2  'Center
  27.          Appearance      =   0  'Flat
  28.          BorderStyle     =   0  'None
  29.          BeginProperty Font 
  30.             Name            =   "MS Sans Serif"
  31.             Size            =   9.75
  32.             Charset         =   0
  33.             Weight          =   700
  34.             Underline       =   0   'False
  35.             Italic          =   0   'False
  36.             Strikethrough   =   0   'False
  37.          EndProperty
  38.          Height          =   240
  39.          Index           =   1
  40.          Left            =   15
  41.          TabIndex        =   1
  42.          Text            =   "255"
  43.          Top             =   0
  44.          Width           =   375
  45.       End
  46.       Begin VB.TextBox txtOctet 
  47.          Alignment       =   2  'Center
  48.          Appearance      =   0  'Flat
  49.          BorderStyle     =   0  'None
  50.          BeginProperty Font 
  51.             Name            =   "MS Sans Serif"
  52.             Size            =   9.75
  53.             Charset         =   0
  54.             Weight          =   700
  55.             Underline       =   0   'False
  56.             Italic          =   0   'False
  57.             Strikethrough   =   0   'False
  58.          EndProperty
  59.          Height          =   240
  60.          Index           =   2
  61.          Left            =   495
  62.          TabIndex        =   2
  63.          Text            =   "255"
  64.          Top             =   0
  65.          Width           =   375
  66.       End
  67.       Begin VB.TextBox txtOctet 
  68.          Alignment       =   2  'Center
  69.          Appearance      =   0  'Flat
  70.          BorderStyle     =   0  'None
  71.          BeginProperty Font 
  72.             Name            =   "MS Sans Serif"
  73.             Size            =   9.75
  74.             Charset         =   0
  75.             Weight          =   700
  76.             Underline       =   0   'False
  77.             Italic          =   0   'False
  78.             Strikethrough   =   0   'False
  79.          EndProperty
  80.          Height          =   240
  81.          Index           =   3
  82.          Left            =   975
  83.          TabIndex        =   3
  84.          Text            =   "255"
  85.          Top             =   0
  86.          Width           =   375
  87.       End
  88.       Begin VB.TextBox txtOctet 
  89.          Alignment       =   2  'Center
  90.          Appearance      =   0  'Flat
  91.          BorderStyle     =   0  'None
  92.          BeginProperty Font 
  93.             Name            =   "MS Sans Serif"
  94.             Size            =   9.75
  95.             Charset         =   0
  96.             Weight          =   700
  97.             Underline       =   0   'False
  98.             Italic          =   0   'False
  99.             Strikethrough   =   0   'False
  100.          EndProperty
  101.          Height          =   240
  102.          Index           =   4
  103.          Left            =   1455
  104.          TabIndex        =   4
  105.          Text            =   "255"
  106.          Top             =   0
  107.          Width           =   375
  108.       End
  109.       Begin VB.Label lblDot 
  110.          Appearance      =   0  'Flat
  111.          AutoSize        =   -1  'True
  112.          BackColor       =   &H80000005&
  113.          Caption         =   "."
  114.          BeginProperty Font 
  115.             Name            =   "MS Sans Serif"
  116.             Size            =   13.5
  117.             Charset         =   0
  118.             Weight          =   700
  119.             Underline       =   0   'False
  120.             Italic          =   0   'False
  121.             Strikethrough   =   0   'False
  122.          EndProperty
  123.          ForeColor       =   &H80000008&
  124.          Height          =   345
  125.          Index           =   1
  126.          Left            =   390
  127.          TabIndex        =   7
  128.          Top             =   -90
  129.          Width           =   105
  130.       End
  131.       Begin VB.Label lblDot 
  132.          Appearance      =   0  'Flat
  133.          AutoSize        =   -1  'True
  134.          BackColor       =   &H80000005&
  135.          Caption         =   "."
  136.          BeginProperty Font 
  137.             Name            =   "MS Sans Serif"
  138.             Size            =   13.5
  139.             Charset         =   0
  140.             Weight          =   700
  141.             Underline       =   0   'False
  142.             Italic          =   0   'False
  143.             Strikethrough   =   0   'False
  144.          EndProperty
  145.          ForeColor       =   &H80000008&
  146.          Height          =   345
  147.          Index           =   2
  148.          Left            =   870
  149.          TabIndex        =   6
  150.          Top             =   -90
  151.          Width           =   105
  152.       End
  153.       Begin VB.Label lblDot 
  154.          Appearance      =   0  'Flat
  155.          AutoSize        =   -1  'True
  156.          BackColor       =   &H80000005&
  157.          Caption         =   "."
  158.          BeginProperty Font 
  159.             Name            =   "MS Sans Serif"
  160.             Size            =   13.5
  161.             Charset         =   0
  162.             Weight          =   700
  163.             Underline       =   0   'False
  164.             Italic          =   0   'False
  165.             Strikethrough   =   0   'False
  166.          EndProperty
  167.          ForeColor       =   &H80000008&
  168.          Height          =   345
  169.          Index           =   3
  170.          Left            =   1350
  171.          TabIndex        =   5
  172.          Top             =   -90
  173.          Width           =   105
  174.       End
  175.    End
  176. End
  177. Attribute VB_Name = "DJIp"
  178. Attribute VB_GlobalNameSpace = False
  179. Attribute VB_Creatable = True
  180. Attribute VB_PredeclaredId = False
  181. Attribute VB_Exposed = False
  182. Option Explicit
  183. Option Base 1
  184. Enum ipBorder
  185.   ccNone = 0
  186.   ccFixedSingle = 1
  187. End Enum
  188. Enum AppearanceStyle
  189.   ccFlat = 0
  190.   cc3D = 1
  191. End Enum
  192. Private m_BackColor As OLE_COLOR
  193. Private m_ForeColor As OLE_COLOR
  194. Private m_ValidIp As Boolean
  195.  
  196. 'Event Declarations:
  197. Event Click()
  198. Attribute Click.VB_Description = "Occurs when the user presses and then releases a mouse button over an object."
  199. Event Change()
  200. Attribute Change.VB_Description = "Occurs when the contents of a control have changed."
  201.  
  202.  
  203. Public Property Get BackColor() As OLE_COLOR
  204. Attribute BackColor.VB_Description = "Returns/sets the background color used to display text and graphics in an object."
  205.   BackColor = m_BackColor
  206. End Property
  207.  
  208. Public Property Let BackColor(ByVal New_BackColor As OLE_COLOR)
  209.   Dim intX As Integer
  210.   Dim intC As Integer
  211.   
  212.   intC = txtOctet.Count
  213.   For intX = 1 To intC
  214.     txtOctet(intX).BackColor() = New_BackColor
  215.     If intX < intC Then lblDot(intX).BackColor = New_BackColor
  216.   Next
  217.   m_BackColor = New_BackColor
  218.   PropertyChanged "BackColor"
  219. End Property
  220.  
  221. Public Property Get ForeColor() As OLE_COLOR
  222. Attribute ForeColor.VB_Description = "Returns/sets the foreground color used to display text and graphics in an object."
  223.   ForeColor = m_ForeColor
  224. End Property
  225.  
  226. Public Property Let ForeColor(ByVal New_ForeColor As OLE_COLOR)
  227.   Dim intX As Integer
  228.   Dim intC As Integer
  229.   
  230.   intC = txtOctet.Count
  231.   For intX = 1 To intC
  232.     txtOctet(intX).ForeColor() = New_ForeColor
  233.     If intX < intC Then lblDot(intX).ForeColor = New_ForeColor
  234.   Next
  235.   m_ForeColor = New_ForeColor
  236.   PropertyChanged "ForeColor"
  237. End Property
  238.  
  239. 'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
  240. 'MappingInfo=UserControl,UserControl,-1,Enabled
  241. Public Property Get Enabled() As Boolean
  242. Attribute Enabled.VB_Description = " Returns/sets a value that determines whether an object can respond to user-generated events."
  243.   Enabled = UserControl.Enabled
  244. End Property
  245.  
  246. Public Property Let Enabled(ByVal New_Enabled As Boolean)
  247.   UserControl.Enabled() = New_Enabled
  248.   PropertyChanged "Enabled"
  249. End Property
  250. Public Property Get ValidIp() As Boolean
  251. Attribute ValidIp.VB_Description = "Sets/returns state of valid ip checking. When true, will not allow an octet outside the valid range of 0-255"
  252.   ValidIp = m_ValidIp
  253. End Property
  254.  
  255. Public Property Let ValidIp(ByVal New_Valid As Boolean)
  256.   m_ValidIp = New_Valid
  257.   PropertyChanged "ValidIp"
  258. End Property
  259. Public Property Get Appearance() As AppearanceStyle
  260. Attribute Appearance.VB_Description = " Returns/sets whether or not an object is painted at run time with 3-D effects."
  261.   Appearance = UserControl.Appearance
  262. End Property
  263.  
  264. Public Property Let Appearance(ByVal New_Appearance As AppearanceStyle)
  265.   UserControl.Appearance() = New_Appearance
  266.   PropertyChanged "Appearance"
  267. End Property
  268.  
  269.  
  270. 'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
  271. 'MappingInfo=UserControl,UserControl,-1,BorderStyle
  272. Public Property Get BorderStyle() As ipBorder
  273. Attribute BorderStyle.VB_Description = "Returns/sets the border style for an object."
  274.   BorderStyle = UserControl.BorderStyle
  275. End Property
  276.  
  277. Public Property Let BorderStyle(ByVal New_BorderStyle As ipBorder)
  278.   UserControl.BorderStyle() = New_BorderStyle
  279.   PropertyChanged "BorderStyle"
  280. End Property
  281.  
  282. Public Sub Refresh()
  283. Attribute Refresh.VB_Description = "Forces a complete repaint of a object."
  284.   Dim intX As Integer
  285.   Dim intC As Integer
  286.   
  287.   intC = txtOctet.Count
  288.   UserControl.Refresh
  289.   For intX = 1 To intC
  290.     txtOctet(intX).Refresh
  291.     If intX < intC Then lblDot(intX).Refresh
  292.   Next
  293. End Sub
  294.  
  295. 'Load property values from storage
  296. Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
  297.   With Me
  298.     .BackColor = PropBag.ReadProperty("BackColor", &H80000005)
  299.     .ForeColor = PropBag.ReadProperty("ForeColor", &H80000008)
  300.     .ValidIp = PropBag.ReadProperty("ValidIp", True)
  301.   End With
  302.   UserControl.Enabled = PropBag.ReadProperty("Enabled", True)
  303.   UserControl.BorderStyle = PropBag.ReadProperty("BorderStyle", ccFixedSingle)
  304.   UserControl.Appearance = PropBag.ReadProperty("Appearance", ccFlat)
  305. End Sub
  306.  
  307. 'Write property values to storage
  308. Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
  309.  
  310.   Call PropBag.WriteProperty("BackColor", txtOctet(1).BackColor, &H80000005)
  311.   Call PropBag.WriteProperty("ForeColor", txtOctet(1).ForeColor, &H80000008)
  312.   Call PropBag.WriteProperty("Enabled", UserControl.Enabled, True)
  313.   Call PropBag.WriteProperty("BorderStyle", UserControl.BorderStyle, ccFixedSingle)
  314.   Call PropBag.WriteProperty("Appearance", UserControl.Appearance, ccFlat)
  315.   Call PropBag.WriteProperty("ValidIp", m_ValidIp, True)
  316.   
  317. End Sub
  318. Private Sub UserControl_InitProperties()
  319.   m_ValidIp = True
  320.   With Me
  321.     .BackColor = &H80000005
  322.     .ForeColor = Ambient.ForeColor
  323.   End With
  324. End Sub
  325. Private Sub UserControl_Resize()
  326.   Dim intX As Integer
  327.   
  328.   With UserControl
  329.     intX = 50 * (.Appearance * .BorderStyle)
  330.     If intX = 0 And .BorderStyle = 1 Then intX = 30
  331.   End With
  332.   
  333.   With Frame1
  334.     .Move 0, 0
  335.     UserControl.Height = .Height + intX
  336.     UserControl.Width = .Width + intX
  337.   End With
  338. End Sub
  339.  
  340. Private Sub txtOctet_Change(Index As Integer)
  341.   Dim strTxt As String
  342.   
  343.   With txtOctet(Index)
  344.     strTxt = .Text
  345.     If Len(strTxt) > 3 Then strTxt = Left(strTxt, 3)
  346.     strTxt = Str(CheckIp(Val(strTxt)))
  347.     .Text = Trim(strTxt)
  348.   End With
  349.   RaiseEvent Change
  350. End Sub
  351.  
  352. Private Function CheckIp(ByVal Octet As Integer) As Integer
  353.   If m_ValidIp Then
  354.     If Octet > 255 Then Octet = 255
  355.     If Octet < 0 Then Octet = 0
  356.   End If
  357.   CheckIp = Octet
  358. End Function
  359.  
  360. Private Sub txtOctet_GotFocus(Index As Integer)
  361.   With txtOctet(Index)
  362.     .SelStart = 0
  363.     .SelLength = Len(.Text)
  364.   End With
  365. End Sub
  366.  
  367. Public Function GetIp() As String
  368. Attribute GetIp.VB_Description = "Returns the IP address "
  369.   Dim intX As Integer
  370.   Dim intC As Integer
  371.   Dim strX As String
  372.   
  373.   intC = txtOctet.Count
  374.   For intX = 1 To intC
  375.     strX = strX & txtOctet(intX)
  376.     If intX < intC Then
  377.       strX = strX & "."
  378.     End If
  379.   Next
  380.   GetIp = strX
  381. End Function
  382.  
  383. Public Sub PutOctet(Octet As Integer, ByVal Address As Integer)
  384. Attribute PutOctet.VB_Description = "Sets value of specified octet."
  385.   Dim intX As Integer
  386.   
  387.   If Octet < 1 Then Octet = 1
  388.   intX = txtOctet.Count
  389.   If Octet > intX Then Octet = intX
  390.   txtOctet(Octet) = Address
  391. End Sub
  392.  
  393. Private Sub txtOctet_KeyPress(Index As Integer, KeyAscii As Integer)
  394.   Select Case KeyAscii
  395.     Case vbKeyReturn
  396.       KeyAscii = 0
  397.       Call MoveFocus(Index, 1)
  398.   End Select
  399. End Sub
  400.  
  401. Private Sub MoveFocus(Index As Integer, Move As Integer)
  402.   Index = Index + Move
  403.   If Index > txtOctet.Count Then Index = 1
  404.   If Index = 0 Then Index = txtOctet.Count
  405.   txtOctet(Index).SetFocus
  406. End Sub
  407.  
  408. Private Sub txtOctet_Click(Index As Integer)
  409.   RaiseEvent Click
  410. End Sub
  411.  
  412.